Especial Multimedia/Especial Multimedia.iso/Multimed/Prg/DEPAL.ZIP/SOURCE.ZIP/PEDMAIN.FRM

Text File | 1995-03-13 | 4KB | 194 lines

VERSION 2.00
Begin Form pedchild
   Caption         =   "<empty>"
   ClientHeight    =   3345
   ClientLeft      =   2820
   ClientTop       =   1755
   ClientWidth     =   4800
   Height          =   4035
   Left            =   2760
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3345
   ScaleWidth      =   4800
   Top             =   1125
   Width           =   4920
   Begin IEDCLASS xDib
      Filename        =   ""
      Height          =   3375
      IDE             =   18757
      Left            =   0
      rgb             =   -1  'True
      selectHeight    =   0
      selectLeft      =   0
      selectTop       =   0
      selectWidth     =   0
      Top             =   0
      Width           =   4515
      Zoom            =   1
   End
   Begin Menu M_Files
      Caption         =   "Files"
      Begin Menu M_Open
         Caption         =   "Open"
      End
      Begin Menu M_sep0
         Caption         =   "-"
      End
      Begin Menu M_save
         Caption         =   "Save"
      End
      Begin Menu M_saveas
         Caption         =   "Save As"
         Enabled         =   0   'False
      End
      Begin Menu M_sep1
         Caption         =   "-"
      End
      Begin Menu M_Rle
         Caption         =   "Save RLE"
      End
      Begin Menu M_asrle
         Caption         =   "Save As RLE"
         Enabled         =   0   'False
      End
   End
   Begin Menu M_window
      Caption         =   "Window"
      WindowList      =   -1  'True
      Begin Menu M_new
         Caption         =   "New"
      End
      Begin Menu M_sep2
         Caption         =   "-"
      End
      Begin Menu M_common
         Caption         =   "Common Palette"
      End
      Begin Menu M_image
         Caption         =   "Image Palette"
      End
   End
   Begin Menu M_colors
      Caption         =   "Colors"
      Begin Menu M_dither236
         Caption         =   "Dither 236"
      End
      Begin Menu M_remap236
         Caption         =   "Remap 236"
      End
      Begin Menu M_optimize40
         Caption         =   "Optimize 40"
      End
      Begin Menu M_optimize100
         Caption         =   "Optimize 100"
      End
   End
End
Option Explicit

Sub Form_Activate ()
    DibPal!Pal.Palette = xDib.Palette
    DibPal!labPos.Caption = "---"
End Sub

Sub Form_Resize ()
    xDib.Width = Me.ScaleWidth
    xDib.Height = Me.ScaleHeight
End Sub

Sub M_common_Click ()

    ComPal.WindowState = 0
    ComPal.Show

End Sub

Sub M_dither236_Click ()
    Call Dither236(Me!xDib, ComPal!Pal.Palette)
    DibPal!Pal.Palette = Me!xDib.Palette
End Sub

Sub M_image_Click ()
    DibPal.WindowState = 0
    DibPal.Show
End Sub

Sub M_new_Click ()

    loadform.Show 1
    If Not Success Then Exit Sub

    On Error GoTo new_error
    Dim X As pedchild
    Set X = New pedchild
    X!xDib.Filename = Filepath
    Call ReadDib(X!xDib)
    X!xDib.Tag = Filepath
    X.Caption = Filename
    X.Show
    Exit Sub

new_error:
    MsgBox Error$
    Unload X
    Exit Sub

End Sub

Sub M_Open_Click ()

    loadform.Show 1

    On Error GoTo Open_Error

    If Success Then
        xDib.Filename = Filepath
        Call ReadDib(xDib)
        xDib.Tag = Filepath
        Me.Caption = Filename
        DibPal!Pal.Palette = xDib.Palette
        DibPal!labPos.Caption = "---"
    End If
    Exit Sub

Open_Error:
    MsgBox Error$
    Exit Sub

End Sub

Sub M_optimize100_Click ()
    Call Optimize(Me!xDib, 100)
    DibPal!Pal.Palette = Me!xDib.Palette
End Sub

Sub M_optimize40_Click ()
    Call Optimize(Me!xDib, 40)
    DibPal!Pal.Palette = Me!xDib.Palette
End Sub

Sub M_remap236_Click ()
    Call Remap236(Me!xDib, ComPal!Pal.Palette)
    DibPal!Pal.Palette = Me!xDib.Palette
End Sub

Sub M_Rle_Click ()

    If Me!xDib.Filename = "" Then
        MsgBox "Undefined file name"
        Exit Sub
    End If
    Call WriteRle(Me!xDib)

End Sub

Sub M_save_Click ()
    If Me!xDib.Filename = "" Then
        MsgBox "Undefined file name"
        Exit Sub
    End If
    Call WriteDib(Me!xDib)
End Sub